home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 09 - 1993 / 09.02 Feb 93 / Date FKEY / InstallFKEY.p < prev    next >
Encoding:
Text File  |  1992-08-17  |  4.4 KB  |  179 lines  |  [TEXT/PJMM]
  1. unit InstallFKEYXCMD;
  2. { in HyperCard }
  3. { InstallFKEY sourceFile,FKEYResID,overwriteBool }
  4. {   Rob Spencer    8/17/92                       }
  5.  
  6. { CopyRes doesn't work; it probably tries to close the System file. }
  7.  
  8. interface
  9.     uses
  10.         HyperXCMD;
  11.     procedure main (paramPtr: XCmdPtr);
  12.  
  13. implementation
  14.  
  15.     procedure main (paramPtr: XCmdPtr);
  16.         const
  17.             kAuthorStr = 'Rob Spencer   August 1992';
  18.             kFormStr = 'form: InstallFKEY sourceFileName,FKEYResID[,overwriteBool]';
  19.             kBadFileStr = 'FKEY source file unknown';
  20.             kNoFKEYStr = 'FKEY not found in source file';
  21.             kExistsStr = 'FKEY already exists in System';
  22.         var
  23.             overwrite: boolean;
  24.             sourceFileName, tempStr: str255;
  25.             tempLong: longint;
  26.             resID: integer;
  27.  
  28.     {-----------------------------------}
  29.  
  30.         procedure HandleError (myStr: str255);
  31.         begin
  32.             case myStr[1] of
  33.                 '!': 
  34.                     myStr := kAuthorStr;
  35.                 '?': 
  36.                     myStr := kFormStr;
  37.                 otherwise
  38.                     myStr := concat('error: ', myStr);
  39.             end;
  40.             paramPtr^.returnValue := PasToZero(paramPtr, myStr);
  41.             exit(main);
  42.         end;
  43.  
  44.   {-----------------------------------}
  45.  
  46.         procedure HandleErrorByNumber (err: OSErr);
  47.             var
  48.                 tempStr: str255;
  49.         begin
  50.             NumToString(err, tempStr);
  51.             tempStr := concat('unspecified # ', tempStr);
  52.             HandleError(tempStr);
  53.         end;
  54.  
  55.   {-----------------------------------}
  56.  
  57.  
  58.         procedure CopyFKEY (sourceFileName: str255; resID: integer; overwrite: boolean);
  59.         { See Knaster, How to Write Mac Software, pp. 328-333. }
  60.             var
  61.                 sourceResFileNum, oldResFileNum, destFileRefNum: integer;
  62.                 tempH, FKEYHandle: handle;
  63.                 err: OSErr;
  64.                 needToClose, done: boolean;
  65.         begin
  66.  
  67.             oldResFileNum := CurResFile;
  68.  
  69.         { Get the FKEY and detach it from its source file. }
  70.  
  71.             sourceResFileNum := OpenResFile(sourceFileName);
  72.             if sourceResFileNum = -1 then
  73.                 HandleError(kBadFileStr);
  74.  
  75.         { If the res file was already open, OpenResFile will not put it at the top. }
  76.  
  77.             if (sourceResFileNum = CurResFile) and (sourceResFileNum <> oldResFileNum) then
  78.                 needToClose := true
  79.             else
  80.                 needToClose := false;
  81.  
  82.             UseResFile(sourceResFileNum);
  83.             FKEYHandle := GetResource('FKEY', resId);
  84.             if (ResError <> noErr) or (FKEYHandle = nil) then
  85.                 begin
  86.                     if needToClose then
  87.                         CloseResFile(sourceResFileNum);
  88.                     HandleError(kNoFKEYStr);
  89.                 end;
  90.  
  91.             DetachResource(FKEYHandle);
  92.             if needToClose then
  93.                 CloseResFile(sourceResFileNum);
  94.             MoveHHi(FKEYHandle);
  95.  
  96.         { Now copy it to the System file. }
  97.  
  98.             destFileRefNum := 0;                        { the System file is our destination }
  99.  
  100.             UseResFile(destFileRefNum);
  101.  
  102.         { Check for pre-existing FKEYs with our id. }
  103.  
  104.             done := false;
  105.             repeat                                                    { remove all resources with our type & id }
  106.                 tempH := Get1Resource('FKEY', resID);
  107.                 if (tempH = nil) or (HomeResFile(tempH) <> destFileRefNum) then
  108.                     done := true
  109.                 else
  110.                     begin
  111.                         if not overwrite then
  112.                             begin
  113.                                 done := true;
  114.                                 HandleError(kExistsStr);
  115.                             end
  116.                         else
  117.                             begin
  118.                                 RmveResource(tempH);
  119.                                 DisposHandle(tempH);
  120.                             end;
  121.                     end;
  122.             until done;
  123.  
  124.             AddResource(FKEYHandle, 'FKEY', resID, '');        { add our resource   }
  125.  
  126.             if ResError <> noErr then
  127.                 HandleErrorByNumber(ResError)
  128.             else
  129.                 begin
  130.                     ChangedResource(FKEYHandle);
  131.                     UpdateResFile(destFileRefNum);                        { out to disk now... }
  132.                     if ResError <> noErr then
  133.                         HandleErrorByNumber(ResError)
  134.                 end;
  135.  
  136.             UseResFile(oldResFileNum);
  137.         end;
  138.  
  139.   {------------------ main -----------------}
  140.  
  141.     begin
  142.  
  143.         { Get all parameters. }
  144.  
  145.         if paramPtr^.paramCount < 2 then
  146.             HandleError('?');
  147.         if (paramPtr^.params[1] = nil) or (paramPtr^.params[2] = nil) then
  148.             HandleError('?');
  149.  
  150.         Hlock(paramPtr^.params[1]);
  151.         ZeroToPas(paramPtr, paramPtr^.params[1]^, sourceFileName);
  152.         Hunlock(paramPtr^.params[1]);
  153.  
  154.         if sourceFileName = '' then
  155.             HandleError('?')
  156.         else if sourceFileName[1] in ['!', '?'] then
  157.             HandleError(sourceFileName[1]);
  158.  
  159.         Hlock(paramPtr^.params[2]);
  160.         ZeroToPas(paramPtr, paramPtr^.params[2]^, tempStr);
  161.         Hunlock(paramPtr^.params[2]);
  162.         StringToNum(tempStr, tempLong);
  163.         resId := tempLong;
  164.  
  165.         overwrite := true;
  166.         if paramPtr^.paramCount > 2 then
  167.             begin
  168.                 Hlock(paramPtr^.params[3]);
  169.                 ZeroToPas(paramPtr, paramPtr^.params[3]^, tempStr);
  170.                 Hunlock(paramPtr^.params[3]);
  171.                 if tempStr <> '' then
  172.                     if tempStr[1] in ['F', 'f', 'N', 'n'] then
  173.                         overwrite := false;
  174.             end;
  175.  
  176.         CopyFKEY(sourceFileName, resID, overwrite);        { Do the work. }
  177.         paramPtr^.returnValue := nil;
  178.     end;
  179. end.